package TeeTemplate;
use strict;
use File::Basename;
use Data::Dumper;

our ($VERSION, @ISA, @EXPORT, @EXPORT_OK);
use Exporter ();
@ISA = qw(Exporter);
@EXPORT = qw(template ftemplate dtemplate tpl__undef tpl__clear);

$VERSION = '4.30';

# Preloaded methods go here.

our $Def = {}; # default values

# Usage:
#	tpl($text,HASH-REF,HASH-REF);
my $deep;
sub tpl {
    my ($txt,$defs,$top) = @_;
    return '' if ! defined $txt;
    return '++TEE_DEEP++' if ++$deep>50; # recursion trap
    $txt =~ s{ 
       %%(/?\w{1,40}?)%% # replace only once -> no recursion $1
     | %(/?\w{1,40}?)% # replacement %xxx% -> $2
     | (\s*)%(/?\w{1,10}?)\:([\w\.\/\\]{1,1024}?)%(\s*) # replacement incl file $3 $4($5) $6
      # start with $7 <def:$7> $8
     | < DEF(?:\:|\s+) (/?\w.*?) > (.*?) < /DEF > # definition
      # start with $9 <loop:$9> $10
     | < LOOP(?:\:|\s+) (\w.*?) > ( .*?) < /LOOP(?:\:|\s+) \9 > # loops
      # start with $11 -> if($11) $12 else $13
     | < IF(?:\:|\s+) (\w.*?) > ( .*?) (?: < ELSE (?:\:|\s+) \11 > ( .*?) )? < /IF(?:\:|\s+) \11 > # if else
      # start with $14 -> unless($14) $15 else $16
     | < UNLESS(?:\:|\s+) (\w.*?) > (.*?) (?: < ELSE (?:\:|\s+) \14 > (.*?) )? < /UNLESS(?:\:|\s+) \14 > # unless else
      # start with $17 -> del $17
     | < DEL(?:\:|\s+) (/?\w.*?) > .*? < /DEL(?:\:|\s+) \17 > # delete always
      # start with $18: clear a b c d -> a=b=c=d=''
     | < CLEAR > (.*?) < /CLEAR >
      # start with $19
     | < PERL > (.*?) < /PERL > # run perl
#     | < C(?:\:|\s+) ([\/\w].*?) > # only for debug $20
    }
    { 
      if(defined $1) { # replacement
	 tpl_replace1($1,$defs,$top)
      }
      elsif(defined $2) { # replacement
	 tpl_replace($2,$defs,$top)
      }
      elsif(defined $3) { # replacement
	 tpl_replace_general($3,$4,$5,$6,$defs,$top)
      }
      elsif(defined $7) { # definition
        $defs->{$7} = $8;
        "";		  # delete on output
      }
      elsif(defined $9) { # loop <name_of_loop> <loop_body>
        tploop($9,$10,$defs,$top)
      }
      elsif(defined $11) { # condition if else
        my $v=exists $defs->{$11} ? $defs->{$11} : $top->{$11};
	if( $v ) { tpl($12,$defs,$top); }
	else     { tpl($13,$defs,$top); }
      }
      elsif(defined $14) { # condition unless
        my $v=exists $defs->{$14} ? $defs->{$14} : $top->{$14};
        unless( $v ) { tpl($15,$defs,$top); }
	else         { tpl($16,$defs,$top); }
      }
      elsif(defined $17) { # delete portion
	"";
      }
      elsif(defined $18) { # clear
	tpl_clear($18,$defs,$top);
      }
      elsif(defined $19) { # perl
	tpl_perl($19,$defs,$top);
      }
#      elsif(defined $20) { # CHECK
#        print "<--------------- FOUND ------------>\n";
#	"XXX";
#      }
    }gsex;
    $deep--;
    $txt;
} # end tpl !!! nemazat TReplace hleda podle toho

# $var is space delimited list of variables to clear if undefined
sub tpl_clear {
  my ($var,$defs,$top) = @_;
  my @p = split(' ', $var);
  for (@p) { 
    unless( exists $defs->{$_} ) {
      $defs->{$_}='' ;
      $top->{__clear}{$_}=0; # for error checking -> cleared vars
    }
  }
  return '';
}

sub tpl_perl {
    my ($cmd,$defs,$top) = @_;
    my $script = "$top->{__FILE_PATH}/$top->{__FILE_NAME}.perl";
    require $script if -x $script;
    eval $cmd;
}

# replace only once: needed for encoded string in <a href="%20%...">
sub tpl_replace1 {
  my ($txt,$defs,$top) = @_;
  if(exists $defs->{$txt} ) { return $defs->{$txt}; }
  elsif($defs != $top and exists $top->{$txt} ) { return $top->{$txt}; }
  $top->{__undef}{$txt}=0; # for error checking -> undefined vars
  return "%%$txt%%";
}

# replace with recursion
sub tpl_replace {
  my ($txt,$defs,$top) = @_;
  if(exists $defs->{$txt} ) { return tpl($defs->{$txt},$defs,$top) }
  elsif($defs != $top and exists $top->{$txt} ) { return tpl($top->{$txt},$defs,$top) }

  $top->{__undef}{$txt}=0; # for error checking -> undefined vars
  return "%$txt%";
}

# replace with recursion
# incl:  substitue while file
# nincl: definition file - no output
sub tpl_replace_general {
  my ($prefix,$par,$txt,$infix,$defs,$top) = @_;
  if($par eq 'incl' or $par eq 'nincl') {
    my $file = find_file($txt);
    return '' if exists $top->{__FILE_INCLUDE}{$file};
    $top->{__FILE_INCLUDE}{$file} = 1; # to prevent cyclic include
    if($file) {
      my $in_txt  = read_file($file);
      my $out_txt = tpl($in_txt,$defs,$top);
      return $par eq 'incl' ? $out_txt : '';
    }
    else { $top->{__undef}{"$par:$txt"}=0; }
  }
  return "$prefix%$par:$txt%$infix";
}

# Usage:
#	tploop(def,text,HASH-REF,HASH-REF)
#    help function to implement loops
sub tploop {
    my ($name,$txt,$defs,$top) = @_;
    my $href;
    my $rtxt='';
    if( exists( $defs->{$name}) ) {
	foreach $href ( @{ $defs->{$name} } ) {
	    $rtxt .= tpl($txt,$href,$top)
	}
    }
    return $rtxt;
}

# Usage:
#	template(\%HASH,$text);
sub template {
    my ($defs,$txt) = @_;
    $deep=0;
    my $s = tpl($txt,$defs,$defs);
    return $s;
}

# find file or undef
sub find_file {
  my $file = shift;
  my $path = $Def->{PATH} ? $Def->{PATH} : ['.'];
  if($file =~ /^\//) { # absolute path
    return ( -e $file ? $file : undef );
  }
  for my $dir ( @$path ) {
    return "$dir/$file" if -e "$dir/$file";
  }
  return undef;
}

# read whole file in one line
sub read_file {
  my $file = shift;
  local *I;
  my $in_txt;
  open(I,$file) or die "Error: Cannot open $file.\n";
  { 
    local($/) = undef;
    $in_txt = <I>;
  }
  close I;
  return $in_txt;
}

# Usage
#	ftemplate(\%HASH, @FILES_NAMES)
sub ftemplate {
  my ($defs,@files) = @_;
  my ($in_txt,$out_txt);
  $out_txt='';
  # default file -> prgname.html if files not specified
  @$defs{qw(__PRG_NAME __PRG_PATH __PRG_SUFFIX)}=fileparse($0,'\..*');
  push @files,"$defs->{__PRG_PATH}/$defs->{__PRG_NAME}.html" unless scalar @files;
  foreach my $file ( @files ) {
    $in_txt = read_file($file);
    $defs->{__FILE}=$file;
    @$defs{qw(__FILE_NAME __FILE_PATH __FILE_SUFFIX)}=fileparse($file,'\..*');
    $out_txt .= template($defs,$in_txt);
    delete @$defs{ qw(__FILE __FILE_NAME __FILE_PATH __FILE_SUFFIX __FILE_INCLUDE) };
  }
  delete @$defs{ qw(__PRG_NAME __PRG_PATH __PRG_SUFFIX) };
  return $out_txt;
}


# dtemplate(hash,file1, file2, ...)
# as ftemplate but use default values defined in Def
# more general then ftemplate
#  PATH -> array of search path {PATH} = ['.', ...]
#  DAT  -> hash of template values
sub dtemplate {
  my $defs;
  $defs = shift;
  unless($defs) { 
    $defs = exists $Def->{DAT} ? $Def->{DAT} : {};
  }
  my @files;
  FILE: for my $f (@_) {
    next unless $f; # skip '' or undef
    my $ff = find_file($f);
    if($ff) { push @files,$ff; next FILE; }
    die "Error: Cannot find $f.";
  }
  return ftemplate($defs,@files); # folame i kdyz @files je prazdny
}

sub tpl__undef {
  my $defs = shift;
  return keys %{ $defs->{__undef} };
}

sub tpl__clear {
  my $defs = shift;
  return  keys %{ $defs->{__clear} };
}

1;
__END__

=head1 NAME

TeeTemplate - Magic Templates for Perl.

=head1 SYNOPSIS

    use TeeTemplate;
    template(HASH-REF, text)
or
    ftemplate(HASH-REF, file1, file2, ...)
or
    dtemplate(file1,file2, ...)

=head1 DESCRIPTION

Templates - just another way to simplify your life.
Includes definitions, conditions, deletions, loops and interpolations.
With commands (DEF LOOP IF UNLESS) you can do almost everything
with your templates.

Properties:
    - dynamic patern match - it means replace first occurence of 
      pattern xxx="whatever" with xxx="myvalue" - this is very usefull !!!
    - infinite depth of variables recursion with max depth checking
    - global variables access in any depth of loop
    - inline definitions of variables in HTML text, variables defined 
      in one template can be used in another one
    - simple condition IF and UNLESS (no OR, AND ...)
    - simple code !!!

=head1 HISTORY

First version starts in early 2001 - with intention to simplify
communication between graphics designers and perl developers.
Several templates were tested (FastTemplate, DynamicTemplate, 
FormTemplate, Template, TextTemplate ...)
but these were quite outside of my need.

Requirements were:

    - designers must use their WYSIWYG graphics software
    - programmers must run perl (in PHP I don't know how to do it)
    - simple but powerfull HTML template tags XML compatible

All goals were fullfilled only as much as I can do it.

=head1 LANGUAGE IN HTML

Spaces are not allowed in <XXX> and <XXX/>

%X% - variable X will be used, if variable is not found in
      given loop then also top level is searched
special variable
%incl:file%  - include file
%nincl:file% - include file but no output (only definition are loaded)

<DEF X>...</DEF> - set X to ...

<IF X>...</IF X> - if X exists and true then ... is included in output
<IF:X>...</IF:X> - (xml compatible version)

<UNLESS X>...</UNLESS X> - if X not exists or false then ... is included in output
<UNLESS:X>...</UNLESS:X> - (xml style compatible version)

<DEL X>...</DEL X> - select part is deleted on output
<DEL:X>...</DEL:X> - (xml style compatible version)

<LOOP X>...</LOOP X> - start nested loop. X should point to array of hashes
<LOOP:X>...</LOOP:X> - (xml style compatible version)


=head1 EXAMPLE

Suppose input file:

    # Eaxmple: usage of variable 'a'
 %a%
    # Eaxmple: 'b' not defined then put everything as it was
 B is %b%
    # Eaxmple: define 'b' as 'a'
 <DEF b>B=[%a%]</DEF>
    # Eaxmple: usage of 'b'
 %b%
    # Eaxmple: condition if
 <IF X>OK</IF X> x
    # Eaxmple: condition unless
 <UNLESS X>OK</UNLESS X> xx
    # Eaxmple: start loop 'lp'
 <LOOP lp>
	# use loop variables 'x,y,z'
    [%x%:%y%:%z%]
	# nested loop 'lp1'
    <LOOP lp1>
	    # use top level variable 'b'
        [%b%]
	    # use loop variables 'o'
        [%o%]
        # end of nested loop 'lp1'
    </LOOP lp1>
    # end of loop 'lp'
 </LOOP lp>

We define variables for this example

 my %tpl;
 
 # top level variable
 $tpl{a}="Hello";
 
 # Look carefully how to construct loop variables
 # loop variable must point to ARRAY !!!
 # and each cell must points to HASH !!!
 $tpl{lp}=[
    { x=>'x0', y=>'y0', z=>'z0',
    lp1 => [	# nested loop
	    { o=>1 ... },
	    { o=>2 ... },
	   ]
    },
    { x=>'x1', y=>'y1', z=>'z1',
    lp1 => [	# nested loop
	    { o=>3 ... },
	    { o=>4 ... },
	    { o=>5 ... },
	    { o=>6 ... },
	   ]
    }
 ];

 Output of template(%tpl,$text);

 Hello
 B is %b%
 B=[Hello]
  x
 OK xx
 [x0:y0:z0]
     [B=[Hello]][1]
     [B=[Hello]][2]
 [x1:y1:z1]
    [B=[Hello]][3]
    [B=[Hello]][4]
    [B=[Hello]][5]
    [B=[Hello]][6]

 Fine

=head1 TRICKS

With templates you really need to read whole input file into SCALAR.
You can use trick (see perlfaq).
 {
    local($/) = undef;
    $lines = <>;
 }

It is done is function ftemplate.

=head1 COPYRIGHT

    Copyright (c) 2001 Anton Sedlak. All rights reserved.

    This program is GPL software; you can redistribute it and/or
    modify it under the same terms as Perl itself.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    Artistic License for more details.

=head1 AUTHOR

    Anton Sedlak <ased@cce.cz>

=cut
